home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Games Collection 1 / software vault.zip / software vault / CDR10 / SPX20.ZIP / SPX_DEMO.ZIP / DEMO07.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-24  |  4KB  |  166 lines
  1. Program Demo7;
  2.  
  3. { SPX library - Sound demo 7  Copyright 1993 Scott D. Ramsay  }
  4.  
  5. Uses crt,dos,spx_snd,spx_key,spx_fnc,spx_ems;
  6.  
  7. type
  8.   sndmode = (CHKsnd,PCsnd,LPT1snd,SBsnd);
  9.  
  10. const
  11.   path    = '';
  12.   uems    : boolean = false;
  13.   sound   : array[0..2] of Psound = (nil,nil,nil);
  14.   sndport : word = $42;         { default device = PC speaker }
  15.   _sb     : boolean = false;
  16.   defsnd  : sndmode = CHKsnd;
  17.  
  18. procedure setup;
  19. var
  20.   d : integer;
  21. begin
  22.   setrate(8192);  { Sample rate for files is 8192 }
  23.   for d := 0 to 2 do
  24.     if uems
  25.       then sound[d]  := new(PEMSsound,init(path+'sound'+st(d+1)+'.sfx',sndport,_sb))
  26.       else sound[d]  := new(Psound,init(path+'sound'+st(d+1)+'.sfx',sndport,_sb));
  27. end;
  28.  
  29.  
  30. procedure showit;
  31. begin
  32.   clrscr;
  33.   writeln('Command line:');
  34.   writeln(' DEMO7  [PC][SB][LPT1]');
  35.   writeln('     PC    - use pc speaker');
  36.   writeln('     SB    - use sound blaster or compatible');
  37.   writeln('     LPT1  - use DAC device on LPT1');
  38.   writeln('Keys:');
  39.   writeln(' ESC          - quit demo');
  40.   writeln(' 1..3         - play sounds');
  41.   writeln;
  42.   write('Press SPACE to continue');
  43.   clearbuffer;
  44.   repeat until space;
  45. end;
  46.  
  47.  
  48. function getvst(s:string;b:byte):string;
  49. var
  50.   v : string;
  51. begin
  52.   inc(b); v := '';
  53.   while (b<=length(s)) and (s[b]<>#32) do
  54.     begin
  55.       v := v+s[b];
  56.       inc(b);
  57.     end;
  58.   getvst := v;
  59. end;
  60.  
  61.  
  62. { convert a hex number to a decimal }
  63. function hex2dec(what:string) : integer;
  64. var
  65.   i,rslt : integer;
  66. begin
  67.   rslt := 0;
  68.   for i := 1 to length(what) do
  69.     begin
  70.       rslt := rslt shl 4;
  71.       if what[i]<'A'
  72.         then rslt := rslt+(ord(what[i])-$30)
  73.         else rslt := rslt+(ord(what[i])-55);
  74.     end;
  75.   hex2dec := rslt;
  76. end;
  77.  
  78.  
  79. function blastercheck:boolean;
  80. var
  81.   s : string;
  82. begin
  83.   s := ups(getenv('BLASTER'));
  84.   if pos('A',s)<>0
  85.     then
  86.       begin
  87.         sndport := hex2dec(getvst(s,pos('A',s)));
  88.         _sb := SBReset(sndport);
  89.         if not _sb
  90.           then
  91.             begin
  92.               sndport := SBfindBase; _sb := (sndport<>0);
  93.               if not _sb
  94.                 then sndport := $42;
  95.             end;
  96.       end;
  97.   blastercheck := _sb;
  98. end;
  99.  
  100.  
  101. procedure checkparms;
  102. var
  103.   tp,pa : word;
  104.   s     : string;
  105.   d     : integer;
  106. begin
  107.   writeln('SPX library - Sound demo 7');
  108.   writeln('Copyright 1993 Scott D. Ramsay');
  109.   writeln;
  110.   s := '';
  111.   for d := 1 to paramcount do
  112.     s := s+ups(paramstr(1));
  113.   if pos('LPT1',s)<>0
  114.     then defsnd := LPT1snd
  115.     else
  116.   if pos('SB',s)<>0
  117.     then defsnd := SBsnd
  118.     else
  119.   if pos('PC',s)<>0
  120.     then defsnd := PCsnd;
  121.   if not EMSinstalled or not emsSTATUS
  122.     then uems := false
  123.     else
  124.       begin
  125.         EMSpages(tp,pa);
  126.         if pa>=5
  127.           then
  128.             begin
  129.               uems := true;
  130.               writeln('Expanded memory detected and used')
  131.             end
  132.           else writeln('Expanded memory detected, but not enough available');
  133.       end;
  134.   case defsnd of
  135.     CHKsnd,
  136.     SBsnd   : blastercheck;
  137.     LPT1snd : sndport := $378;
  138.   end;
  139.   if _sb
  140.     then writeln('Sound card detected')
  141.     else
  142.       if defsnd<>LPT1snd
  143.         then writeln('Using PC speaker')
  144.         else writeln('Using DAC on LPT1');
  145.   writeln;
  146. end;
  147.  
  148.  
  149. procedure animate;
  150. begin
  151.   clrscr;
  152.   writeln('ESC - quit    1..3 - sounds ');
  153.   repeat
  154.     if vl(ch) in [1..3]
  155.       then sound[vl(ch)-1]^.play(true);
  156.     delay(100);  { kill some cycles }
  157.   until esc;
  158. end;
  159.  
  160.  
  161. begin
  162.   checkparms;
  163.   showit;
  164.   setup;
  165.   animate;
  166. end.